home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Neurons / Neural Feedback Tester < prev    next >
Lisp/Scheme  |  1998-10-26  |  6KB  |  158 lines
  1. (def-neuron rules
  2.  
  3.   ;;;; Level1 rules
  4.  
  5.   (and (in 1 '=) (in 2 '=) (all-in 3 '(a c) -10 10))
  6.        (transpose-symbol 'b trpos)
  7.   (and (in 1 '=) (in 2 '=) (all-in 3 '(c a) -10 10))
  8.        (transpose-symbol 'b trpos)
  9.   (and (in 1 '=) (in 2 '=) (all-in 3 '(a a) -10 10))
  10.        (transpose-symbol (pick-random '(a b -b =)) trpos)
  11.   (and (in 1 '=) (in 2 '=) (all-in 3 '(a b) -10 10))
  12.        (transpose-symbol (pick-random '(c d)) trpos)
  13.   (and (in 1 '=) (in 2 '=) (all-in 3 '(b a) -10 10))
  14.        (transpose-symbol (pick-random '(-b -c)) trpos)
  15.   (and (in 1 '=) (in 2 '=) (in 3 '=))
  16.        (transpose-symbol (in 3 0 -1) 1)
  17.  
  18.   ;;;; Level2 rules
  19.  
  20.   (and (in 1 '=) (all-in-parallel '(2 3) '((a) (a)) down2 up2))
  21.       (transpose-symbol (pick-random '(-b b =)) trpos)
  22.   (and (in 1 '=) (all-in-parallel '(2 3) '((a) (b)) down2 up2))
  23.       (transpose-symbol '-b trpos)
  24.   (and (in 1 '=) (all-in-parallel '(2 3) '((a) (c)) down2 up2))
  25.       (transpose-symbol 'b trpos)
  26.   (and (in 1 '=) (all-in-parallel '(2 3) '((a) (=)) down2 up2))
  27.       (transpose-symbol (pick-random '(= -b b)) trpos)
  28.   (and (in 1 '=) (all-in-parallel '(2 3) '((b) (a)) down2 up2))
  29.       (transpose-symbol 'c trpos)
  30.   (and (in 1 '=) (all-in-parallel '(2 3) '((c) (a)) down2 up2))
  31.       (transpose-symbol 'b trpos)
  32.   (and (in 1 '=) (all-in-parallel '(2 3) '((=) (a)) down2 up2))
  33.       (transpose-symbol (pick-random '(= -b b)) trpos)
  34.   (and (in 1 '=) (all-in-parallel '(2 3) '((=) (=)) down2 up2))
  35.       (transpose-symbol (in 1 -1) -1)
  36.  
  37.   ;;;; Level3 rules
  38.  
  39.   (all-in-parallel '(1 2 3) '((a) (a) (a)) down3 up3)
  40.       (transpose-symbol (pick-random '(c -b =)) trpos)
  41.   (all-in-parallel '(1 2 3) '((a) (b) (a)) down3 up3)
  42.       (transpose-symbol (pick-random '(-b =)) trpos)
  43.   (all-in-parallel '(1 2 3) '((a) (b) (b)) down3 up3)
  44.       (transpose-symbol (pick-random '(c -b)) trpos)
  45.   (all-in-parallel '(1 2 3) '((b) (a) (a)) down3 up3)
  46.       (transpose-symbol (pick-random '(c -b)) trpos)
  47.   (all-in-parallel '(1 2 3) '((b) (a) (b)) down3 up3)
  48.       (transpose-symbol (pick-random '(c =)) trpos)
  49.   (all-in-parallel '(1 2 3) '((b) (a) (a)) down3 up3)
  50.       (transpose-symbol (pick-random '(-b =)) trpos)
  51.   (all-in-parallel '(1 2 3) '((a) (a) (c)) down3 up3)
  52.       (transpose-symbol (pick-random '(b -b)) trpos)
  53.   (all-in-parallel '(1 2 3) '((a) (c) (a)) down3 up3)
  54.       (transpose-symbol (pick-random '(b -b =)) trpos)
  55.   (all-in-parallel '(1 2 3) '((a) (c) (c)) down3 up3)
  56.       (transpose-symbol (pick-random '(b -b)) trpos)
  57.   (all-in-parallel '(1 2 3) '((c) (a) (a)) down3 up3)
  58.       (transpose-symbol (pick-random '(b -b =)) trpos)
  59.   (all-in-parallel '(1 2 3) '((c) (a) (c)) down3 up3)
  60.       (transpose-symbol (pick-random '(b -b)) trpos)
  61.   (all-in-parallel '(1 2 3) '((c) (c) (a)) down3 up3)
  62.       (transpose-symbol (pick-random '(b -b =)) trpos)
  63.   (all-in-parallel '(1 2 3) '((a) (a) (=)) down3 up3)
  64.       (transpose-symbol (pick-random '(b c -b -c)) trpos)
  65.   (all-in-parallel '(1 2 3) '((a) (=) (a)) down3 up3)
  66.       (transpose-symbol (pick-random '(b c -b -c)) trpos)
  67.   (all-in-parallel '(1 2 3) '((a) (=) (=)) down3 up3)
  68.       (transpose-symbol (pick-random '(b c -b -c)) trpos)
  69.   (all-in-parallel '(1 2 3) '((=) (a) (=)) down3 up3)
  70.       (transpose-symbol (pick-random '(b c -b -c)) trpos)
  71.   (all-in-parallel '(1 2 3) '((=) (=) (=)) down3 up3)
  72.       (transpose-symbol (pick-random '(a b c -b -c)) trpos)
  73.  
  74.   ;;;; otherwise for levels
  75.  
  76.   (otherwise (cond ((and (in 1 '=) (in 2 '=))          ; level1
  77.                     (transpose-symbol (in 3 0) 1))
  78.                    ((in 1 '=) (pick-random '(a b -b))) ; level2
  79.                    (t (pick-random '(a b -b)))))     ; level3
  80.  
  81. )
  82.  
  83. (setq theme '(a b c d e f e d c b c d c b a h g h f e d h g h e d c h g h d e))
  84.  
  85. (setq down3 -10)
  86. (setq up3 10)
  87. (setq down2 -10)
  88. (setq up2 10)
  89.  
  90. (setq fugue-streams (flatten (append theme (feedback-neuron 'rules 16 (list nil nil (symbol-scale '(a e) theme))))))
  91.  
  92. (setq line1 (symbol-scale '(a h) fugue-streams))
  93. (setq line2 (symbol-shift 32 (symbol-transpose 11 (symbol-scale '(a h) fugue-streams))))
  94. (setq line3 (symbol-shift 64 (symbol-transpose -5 (symbol-scale '(a h) fugue-streams))))
  95. ;(setq line4 (symbol-shift 27 (symbol-transpose 30 (symbol-scale '(a h) fugue-streams))))
  96.  
  97. (defun symbol-to-mapped-integer (s maptable)
  98.   (if (equal s '=)
  99.     0
  100.     (let ((note (symbols-to-notes s maptable)))
  101.       (apply #'note-to-abs note))))
  102.  
  103. (setq new-mater (filter-harmonize3
  104.                  line1 line2 line3 12
  105.                  (activate-tonality (harmonic-minor c 4))
  106.                  '((16 3)) 
  107.                  '((1 2 5 6 10 11)) ; ok too '((1 2 5 6 9 10 11)) ; '((1 2 5 6 8 9 10 11)) ; 
  108.                  '(0 5 7)))
  109.  
  110. (setq hmat1 (filter-deactivate 8 55 (find-change (car new-mater))))
  111. (setq hmat2 (filter-deactivate 8 55 (find-change (cadr new-mater))))
  112. (setq hmat3 (filter-deactivate 8 55 (find-change (caddr new-mater))))
  113.  
  114. (def-instrument-symbol
  115.    lh (symbol-melodize-skip hmat1)
  116.    rh (symbol-shift 1 (symbol-melodize-skip hmat2))
  117.    mh (symbol-shift 1 (symbol-melodize-skip hmat3))
  118. )
  119.  
  120. ;; 1/16 can be at the same time or like here
  121.  
  122. (def-instrument-length
  123.    lh (get-timing '1/8 hmat1) 
  124.    rh (get-timing '1/8 hmat2)
  125.    mh (get-timing '1/8 hmat3)
  126. )
  127.  
  128. (def-instrument-zone
  129.    lh (make-zone (get-timing '1/8 hmat1))
  130.    rh (make-zone (get-timing '1/8 hmat2))
  131.    mh (make-zone (get-timing '1/8 hmat3))
  132. )
  133.  
  134. (def-instrument-tonality
  135.    lh (activate-tonality (harmonic-minor c 4))
  136.    rh (activate-tonality (harmonic-minor c 4))
  137.    mh (activate-tonality (harmonic-minor c 4))
  138. )
  139.  
  140. (def-instrument-velocity
  141.    lh (symbol-to-velocity 50 127 3 (symbol-repeat 4 theme))
  142.    rh (symbol-to-velocity 50 127 3 (reverse (symbol-repeat 4 theme)))
  143.    mh (symbol-to-velocity 50 127 3 (reverse (symbol-repeat 4 theme)))
  144. )
  145.  
  146. (def-instrument-channel
  147.    lh 1
  148.    rh 2
  149.    mh 3
  150. )
  151.  
  152. (compile-instrument-p "ccl;output:" "fugue"
  153.   lh
  154.   rh
  155.   mh
  156. )
  157.  
  158.